home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / src-server / wc_SelectioB.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-10-04  |  15.1 KB  |  384 lines
  1. /* -*-C-*-
  2. ********************************************************************************
  3. *
  4. * File:         wc_SelectioB.c
  5. * RCS:          $Header: wc_SelectioB.c,v 1.3 91/03/14 03:15:13 mayer Exp $
  6. * Description:  XM_SELECTION_BOX_WIDGET_CLASS
  7. * Author:       Niels Mayer, HPLabs
  8. * Created:      Sat Oct 28 04:41:20 1989
  9. * Modified:     Thu Oct  3 23:41:05 1991 (Niels Mayer) mayer@hplnpm
  10. * Language:     C
  11. * Package:      N/A
  12. * Status:       X11r5 contrib tape release
  13. *
  14. * WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. * XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. *
  17. * Permission to use, copy, modify, distribute, and sell this software and its
  18. * documentation for any purpose is hereby granted without fee, provided that
  19. * the above copyright notice appear in all copies and that both that
  20. * copyright notice and this permission notice appear in supporting
  21. * documentation, and that the name of Hewlett-Packard and David Betz not be
  22. * used in advertising or publicity pertaining to distribution of the software
  23. * without specific, written prior permission.  Hewlett-Packard and David Betz
  24. * make no representations about the suitability of this software for any
  25. * purpose. It is provided "as is" without express or implied warranty.
  26. *
  27. * HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  28. * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  29. * IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  30. * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  31. * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  32. * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  33. * PERFORMANCE OF THIS SOFTWARE.
  34. *
  35. * See ./winterp/COPYRIGHT for information on contacting the authors.
  36. * 
  37. * Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  38. * Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  39. *
  40. ********************************************************************************
  41. */
  42. static char rcs_identity[] = "@(#)$Header: wc_SelectioB.c,v 1.3 91/03/14 03:15:13 mayer Exp $";
  43.  
  44. #include <stdio.h>
  45. #include <Xm/Xm.h>
  46. #include <Xm/SelectioB.h>
  47. #include "winterp.h"
  48. #include "user_prefs.h"
  49. #include "xlisp/xlisp.h"
  50. #include "w_funtab.h"
  51. #include "w_XmString.h"
  52.  
  53.  
  54. extern Widget Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(); /* w_classes.c */
  55.  
  56.  
  57. static LVAL k_prompt_dialog;
  58.  
  59. /*****************************************************************************
  60.  * (send XM_SELECTION_BOX_WIDGET_CLASS :new 
  61.  *                           [:managed/:unmanaged]
  62.  *                           [:dialog/:prompt_dialog]
  63.  *                           [<name>]
  64.  *                           <parent> 
  65.  *                           [:XMN_<arg1> <val1>]
  66.  *                           [. . .             ]
  67.  *                           [:XMN_<argN> <valN>])
  68.  *
  69.  * The optional keyword submessage :managed will cause a subsequent call
  70.  * to XtManageChild(). If the submessage :unmanaged is present, or no
  71.  * submessage, then XtManageChild() won't be called, and the resulting
  72.  * widget will be returned unmanaged.
  73.  *
  74.  *   (send XM_SELECTION_BOX_WIDGET_CLASS :new ...)
  75.  *   --> XmCreateSelectionBox();
  76.  *   (send XM_SELECTION_BOX_WIDGET_CLASS :new :dialog ...)
  77.  *   --> XmCreateSelectionDialog();
  78.  *   (send XM_SELECTION_BOX_WIDGET_CLASS :new :prompt_dialog ...)
  79.  *   --> XmCreatePromptDialog();
  80.  ****************************************************************************/
  81. LVAL Xm_Selection_Box_Widget_Class_Method_ISNEW()
  82. {
  83.   extern ArgList Wres_Get_LispArglist(); /* from w_resources.c */
  84.   extern void    Wres_Free_C_Arglist_Data(); /* from w_resources.c */
  85.   extern LVAL k_managed, k_unmanaged, k_dialog;
  86.   LVAL self, o_parent;
  87.   char* name;
  88.   Boolean managed_p;
  89.   LVAL sb_kind;
  90.   Widget widget_id, parent_widget_id;
  91.  
  92.   self = xlgaobject();        /* NOTE: xlobj.c:clnew() returns an OBJECT; if this method
  93.                    returns successfully, it will return a WIDGETOBJ */
  94.   
  95.   /* get optional managed/unmanaged arg */
  96.   if (moreargs() && ((*xlargv == k_managed) || (*xlargv == k_unmanaged)))
  97.     managed_p = (nextarg() == k_managed);
  98.   else
  99.     managed_p = FALSE;        /* by default don't call XtManageChild() */
  100.  
  101.   /* get optional :dialog/:prompt_dialog arg */
  102.   if (moreargs() && ((*xlargv == k_dialog) || (*xlargv ==  k_prompt_dialog)))
  103.     sb_kind = nextarg();
  104.   else
  105.     sb_kind = NIL;        /* default is XmCreateSelectionBox() */
  106.   
  107.   /* get optional <name> arg */
  108.   if (moreargs() && (stringp(*xlargv)))
  109.     name = (char*) getstring(nextarg());
  110.   else
  111.     name = "";            /* default name */
  112.  
  113.   /* get required <parent> widget-object arg */
  114.   parent_widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&o_parent);
  115.  
  116.   /*
  117.    * Store the widget object <self> in the XmNuserData resource on the
  118.    * widget. This will allow us to retrieve the widget object from Xtoolkit
  119.    * functions returning widget ID's without having to keep around a table
  120.    * of widgetID-->widget-objects.
  121.    */
  122.    ARGLIST_RESET(); ARGLIST_ADD(XmNuserData, (XtArgVal) self); 
  123.  
  124.   if (moreargs()) {        /* if there are more arguments, */
  125.     Cardinal xt_numargs;    /* then we have some extra widget resources to set */
  126.     ArgList xt_arglist = Wres_Get_LispArglist(self, parent_widget_id, ARGLIST(), &xt_numargs);
  127.     if (sb_kind == NIL)
  128.       widget_id = XmCreateSelectionBox(parent_widget_id, name, xt_arglist, xt_numargs);
  129.     else if (sb_kind == k_dialog)
  130.       widget_id = XmCreateSelectionDialog(parent_widget_id, name, xt_arglist, xt_numargs);
  131.     else if (sb_kind == k_prompt_dialog)
  132.       widget_id = XmCreatePromptDialog(parent_widget_id, name, xt_arglist, xt_numargs);
  133.     else
  134.       xlfatal("Bug in Xm_Selection_Box_Widget_Class_Method_ISNEW()");
  135.     Wres_Free_C_Arglist_Data();
  136.   }
  137.   else
  138.     if (sb_kind == NIL)
  139.       widget_id = XmCreateSelectionBox(parent_widget_id, name, ARGLIST());
  140.     else if (sb_kind == k_dialog)
  141.       widget_id = XmCreateSelectionDialog(parent_widget_id, name, ARGLIST());
  142.     else if (sb_kind == k_prompt_dialog)
  143.       widget_id = XmCreatePromptDialog(parent_widget_id, name, ARGLIST());
  144.     else
  145.       xlfatal("Bug in Xm_Selection_Box_Widget_Class_Method_ISNEW()");
  146.  
  147.   Wcls_Initialize_WIDGETOBJ(self, widget_id);
  148.  
  149.   if (managed_p)
  150.     XtManageChild(widget_id);
  151.   
  152. #ifdef DEBUG_WINTERP_1
  153.   Wcls_Print_WidgetObj_Info(self);
  154. #endif
  155.   return (self);
  156. }
  157.  
  158.  
  159. /******************************************************************************
  160.  * typedef struct
  161.  * {
  162.  *     int reason;
  163.  *     XEvent    *event;
  164.  *     XmString    value;
  165.  *     int    length;
  166.  * } XmSelectionBoxCallbackStruct;
  167.  ******************************************************************************/
  168. static void Lexical_Bindings_For_XmSelectionBoxCallbackStruct(bindings_list, lexical_env, cd, o_widget)
  169.      LVAL bindings_list;    /* a list of symbols to which values from XmSelectionBoxCallbackStruct are bound */
  170.      LVAL lexical_env;        
  171.      XmSelectionBoxCallbackStruct* cd;
  172.      LVAL o_widget;        /* XLTYPE_WIDGETOBJ */
  173. {
  174.   extern LVAL s_CALLBACK_WIDGET, s_CALLBACK_REASON, s_CALLBACK_XEVENT, s_CALLBACK_VALUE, s_CALLBACK_LENGTH; /* w_callbacks.c */
  175.   extern LVAL Wcb_Get_Callback_Reason_Symbol();    /* w_callbacks.c */
  176.   register LVAL s_bindname;
  177.  
  178.   for ( ; consp(bindings_list); bindings_list = cdr(bindings_list)) {
  179.  
  180.     s_bindname = car(bindings_list);
  181.  
  182.     if (s_bindname == s_CALLBACK_WIDGET) {
  183.       xlpbind(s_bindname, o_widget, lexical_env);
  184.     }
  185.     else if (s_bindname == s_CALLBACK_REASON) {
  186.       xlpbind(s_bindname, Wcb_Get_Callback_Reason_Symbol(cd->reason), lexical_env);
  187.     }
  188.     else if (s_bindname == s_CALLBACK_XEVENT) {
  189.       xlpbind(s_bindname, (cd->event) ? cv_xevent(cd->event) : NIL, lexical_env);
  190.     }
  191.     else if (s_bindname == s_CALLBACK_VALUE) {
  192.       xlpbind(s_bindname, (cd->value) ? cv_xmstring(XmStringCopy(cd->value)) : NIL, lexical_env); /* copy the XmString even though cd->value never looks like it gets freed -- it's inconsistant w/ other callback XmStrings.. maybe it'll get fixed eventually */
  193.     }
  194.     else if (s_bindname == s_CALLBACK_LENGTH) {
  195.       xlpbind(s_bindname, cvfixnum((FIXTYPE) cd->length), lexical_env);
  196.     }
  197.     else {
  198.       extern char temptext[];    /* from winterp.c */
  199.       sprintf(temptext,
  200.           "Unknown binding name in XmSelectionBoxCallbackStruct callback evaluator. Valid symbols are [%s %s %s %s %s].",
  201.           (char*) getstring(getpname(s_CALLBACK_WIDGET)),
  202.           (char*) getstring(getpname(s_CALLBACK_REASON)),
  203.           (char*) getstring(getpname(s_CALLBACK_XEVENT)),
  204.           (char*) getstring(getpname(s_CALLBACK_VALUE)),
  205.           (char*) getstring(getpname(s_CALLBACK_LENGTH)));
  206.       xlerror(temptext, s_bindname);
  207.     }
  208.   }
  209. }
  210.  
  211.  
  212. /******************************************************************************
  213.  * This is called indirectly via XtAddCallback() for callbacks returning
  214.  * an XmSelectionBoxCallbackStruct as call_data.
  215.  ******************************************************************************/
  216. static void XmSelectionBoxCallbackStruct_Callbackproc(widget, client_data, call_data)
  217.      Widget    widget;
  218.      XtPointer client_data;
  219.      XtPointer call_data;
  220. {
  221.   extern void Wcb_Meta_Callbackproc(); /* w_callbacks.c */
  222.  
  223.   Wcb_Meta_Callbackproc(client_data, call_data,
  224.             Lexical_Bindings_For_XmSelectionBoxCallbackStruct,
  225.             NULL);
  226. }
  227.  
  228.  
  229. /******************************************************************************
  230.  * Same as WIDGET_CLASS's :add_callback method except that this understands
  231.  * how to get values from the XmSelectionBoxCallbackStruct.
  232.  * Specifying one or more of the following symbols in the callback bindings 
  233.  * list will bind that symbol's value in the lexical environment of the callback:
  234.  * CALLBACK_WIDGET
  235.  * CALLBACK_REASON
  236.  * CALLBACK_XEVENT
  237.  * CALLBACK_VALUE
  238.  * CALLBACK_LENGTH
  239.  ******************************************************************************/
  240. LVAL Xm_Selection_Box_Widget_Class_Method_ADD_CALLBACK()
  241. {
  242.   extern LVAL Wcb_Meta_Method_Add_Callback(); /* w_callbacks.c */
  243.  
  244.   return (Wcb_Meta_Method_Add_Callback(XmSelectionBoxCallbackStruct_Callbackproc, FALSE));
  245. }
  246.  
  247.  
  248. /******************************************************************************
  249.  * Same as WIDGET_CLASS's :set_callback method except that this understands
  250.  * how to get values from the XmSelectionBoxCallbackStruct.
  251.  * Specifying one or more of the following symbols in the callback bindings 
  252.  * list will bind that symbol's value in the lexical environment of the callback:
  253.  * CALLBACK_WIDGET
  254.  * CALLBACK_REASON
  255.  * CALLBACK_XEVENT
  256.  * CALLBACK_VALUE
  257.  * CALLBACK_LENGTH
  258.  ******************************************************************************/
  259. LVAL Xm_Selection_Box_Widget_Class_Method_SET_CALLBACK()
  260. {
  261.   extern LVAL Wcb_Meta_Method_Add_Callback(); /* w_callbacks.c */
  262.  
  263.   return (Wcb_Meta_Method_Add_Callback(XmSelectionBoxCallbackStruct_Callbackproc, TRUE));
  264. }
  265.  
  266.  
  267. /******************************************************************************
  268.  * (send <selectionbox_widget> :get_child <childname>)
  269.  * ==> returns the WIDGETOBJ correspomding to <childname> which can be one
  270.  * of the following:
  271.  * :DIALOG_LIST, :DIALOG_LIST_LABEL, :DIALOG_SELECTION_LABEL, :DIALOG_WORK_AREA
  272.  * :DIALOG_TEXT, :DIALOG_SEPARATOR, :DIALOG_OK_BUTTON, :DIALOG_APPLY_BUTTON,
  273.  * :DIALOG_CANCEL_BUTTON, :DIALOG_HELP_BUTTON, :DIALOG_DEFAULT_BUTTON
  274.  *
  275.  * Widget XmSelectionBoxGetChild (sb, which)
  276.  *        Widget sb;
  277.  *        int which;
  278.  ******************************************************************************/
  279. LVAL Xm_Selection_Box_Widget_Class_Method_GET_CHILD()
  280. {
  281.   LVAL self, lval_child;
  282.   Widget widget_id;
  283.   int child;
  284.   extern LVAL Wcls_WidgetID_To_WIDGETOBJ();
  285.   extern LVAL s_XmDIALOG_LIST, s_XmDIALOG_LIST_LABEL, s_XmDIALOG_SELECTION_LABEL,
  286.   s_XmDIALOG_WORK_AREA, s_XmDIALOG_TEXT, s_XmDIALOG_SEPARATOR,
  287.   s_XmDIALOG_OK_BUTTON, s_XmDIALOG_APPLY_BUTTON, s_XmDIALOG_CANCEL_BUTTON,
  288.   s_XmDIALOG_HELP_BUTTON, s_XmDIALOG_DEFAULT_BUTTON; /* from w_resources.c */
  289.   
  290.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  291.   lval_child = xlgasymbol();
  292.   xllastarg();
  293.  
  294.   if (lval_child == s_XmDIALOG_LIST)
  295.     child = XmDIALOG_LIST;
  296.   else if (lval_child == s_XmDIALOG_LIST_LABEL)
  297.     child = XmDIALOG_LIST_LABEL;
  298.   else if (lval_child == s_XmDIALOG_SELECTION_LABEL)
  299.     child = XmDIALOG_SELECTION_LABEL;
  300.   else if (lval_child == s_XmDIALOG_WORK_AREA)
  301.     child = XmDIALOG_WORK_AREA;
  302.   else if (lval_child == s_XmDIALOG_TEXT)
  303.     child = XmDIALOG_TEXT;
  304.   else if (lval_child == s_XmDIALOG_SEPARATOR)
  305.     child = XmDIALOG_SEPARATOR;
  306.   else if (lval_child == s_XmDIALOG_OK_BUTTON)
  307.     child = XmDIALOG_OK_BUTTON;
  308.   else if (lval_child == s_XmDIALOG_APPLY_BUTTON)
  309.     child = XmDIALOG_APPLY_BUTTON;
  310.   else if (lval_child == s_XmDIALOG_CANCEL_BUTTON)
  311.     child = XmDIALOG_CANCEL_BUTTON; 
  312.   else if (lval_child == s_XmDIALOG_HELP_BUTTON)
  313.     child = XmDIALOG_HELP_BUTTON;
  314.   else if (lval_child == s_XmDIALOG_DEFAULT_BUTTON)
  315.     child =XmDIALOG_DEFAULT_BUTTON;
  316.   else
  317.     xlerror("Invalid selectionbox child symbol.", lval_child);
  318.     
  319.   return (Wcls_WidgetID_To_WIDGETOBJ(XmSelectionBoxGetChild(widget_id, child)));
  320. }
  321.  
  322.  
  323. /******************************************************************************
  324.  * (send <selectionbox_widget> :GET_LIST_ITEMS)
  325.  *     ==> returns an array of XmStrings.
  326.  *
  327.  * This retrieves the XmSelectionBox widget resources XmNlistItems and
  328.  * XmNlistItemCount from <selectionbox_widget> and returns an array of
  329.  * XmStrings representing the items in the selectionbox's list.
  330.  *******************************************************************************/
  331. LVAL Xm_Selection_Box_Widget_Class_Method_GET_LIST_ITEMS()
  332. {
  333.   LVAL self;
  334.   Widget widget_id;
  335.   XmStringTable xmstrtab;
  336.   int        xmstrtab_size;
  337.  
  338.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  339.   xllastarg();
  340.  
  341.   ARGLIST_RESET();
  342.   ARGLIST_ADD(XmNlistItems, &xmstrtab);
  343.   ARGLIST_ADD(XmNlistItemCount, &xmstrtab_size);
  344.   XtGetValues(widget_id, ARGLIST());
  345.  
  346.   return (Wxms_XmStringTable_To_Lisp_Vector(xmstrtab, xmstrtab_size));
  347. }
  348.  
  349.  
  350. /******************************************************************************
  351.  *
  352.  ******************************************************************************/
  353. Wc_SelectioB_Init()
  354. {
  355.   LVAL o_XM_SELECTION_BOX_WIDGET_CLASS;
  356.   extern LVAL Wcls_Create_Subclass_Of_WIDGET_CLASS(); /* w_classes.c */
  357.   extern      xladdmsg();    /* from xlobj.c */
  358.  
  359.   k_prompt_dialog      = xlenter(":PROMPT_DIALOG");
  360.  
  361.   o_XM_SELECTION_BOX_WIDGET_CLASS =
  362.     Wcls_Create_Subclass_Of_WIDGET_CLASS("XM_SELECTION_BOX_WIDGET_CLASS",
  363.                      xmSelectionBoxWidgetClass);
  364.  
  365.   /* a special :isnew method on this class allows for the creation of this
  366.      widget inside a popup shell if one of the following submessage keywords
  367.      are given: 
  368.      :dialog, :prompt_dialog */
  369.   xladdmsg(o_XM_SELECTION_BOX_WIDGET_CLASS, ":ISNEW", 
  370.        FTAB_Xm_Selection_Box_Widget_Class_Method_ISNEW);
  371.  
  372.   xladdmsg(o_XM_SELECTION_BOX_WIDGET_CLASS, ":ADD_CALLBACK",
  373.            FTAB_Xm_Selection_Box_Widget_Class_Method_ADD_CALLBACK);
  374.  
  375.   xladdmsg(o_XM_SELECTION_BOX_WIDGET_CLASS, ":SET_CALLBACK",
  376.            FTAB_Xm_Selection_Box_Widget_Class_Method_SET_CALLBACK);
  377.  
  378.   xladdmsg(o_XM_SELECTION_BOX_WIDGET_CLASS, ":GET_CHILD",
  379.            FTAB_Xm_Selection_Box_Widget_Class_Method_GET_CHILD);
  380.  
  381.   xladdmsg(o_XM_SELECTION_BOX_WIDGET_CLASS, ":GET_LIST_ITEMS",
  382.            FTAB_Xm_Selection_Box_Widget_Class_Method_GET_LIST_ITEMS);
  383. }
  384.